home *** CD-ROM | disk | FTP | other *** search
/ Software of the Month Club 1996 April / Software of the Month Club 1996 April.iso / pc / win / edu / profan2 / beispiel.lzh / CDPLAY.PRF < prev    next >
Encoding:
Text File  |  1995-07-31  |  13.2 KB  |  577 lines

  1. '
  2. '                       --- Windows CD Player ---
  3. '                                 from
  4. '                             Jⁿrgen Vetter
  5. '                           Gutenbergstra▀e 51
  6. '                            44139 Dortmund
  7. '                           Fido 2:243/4601.6
  8. '                  translated by TechSys Consulting, Inc.   
  9. '
  10. '                             Version 1.00 
  11. '
  12. '     Version 1.5 optical prepared by Roland G. Hⁿlsmann
  13. '
  14. '     This program was tested on a    486/33 MHz 8 MB
  15. '                                     Windows 3.1
  16. '                                     DOS 6.0
  17. '                                     Mitsumi LU005S
  18. '
  19. '
  20. '
  21. '     There appear some differences on monitors with 1024x768 resolution.
  22. '     This program is F R E E W A R E. It is not allowed to charge anything 
  23. '     for distribution. I don't accept any responsibility for damages on
  24. '     hardware or software which may appear by using this program.
  25. '     I also refuse all other duties.
  26. '     The source code may only be changed with my permission.
  27. '     
  28. '     I thank Roland G. Hⁿlsmann for Profan Version 2.5
  29. '
  30. '     I would be glad to get in contact with some other programers
  31. '     Please write a NetMail in Fido.
  32. ' --------------------------------------------------------------------------------------------
  33. '
  34. ' *** program end -> 0
  35. '
  36. declare verkz%
  37. ' *** running mode -> 1 shuffle
  38. '
  39. declare modus%
  40. ' *** 99 tracks can be saved
  41. '
  42. dim$ 99
  43. '
  44. ' *** CD variables
  45. '
  46. declare cdanz%,cdanzs$,cdlaen$,cdplay$,cdtrack$,cdzw$
  47. declare cdakt%,cdalt%,cdmin%,cdsec%,cdmalt%,cdsalt%
  48. '
  49. ' *** counting variables 
  50. '
  51. declare sub%,ende%,zw$,zahl%,mci1$,trenn$,steppos$,disp$,zufall%,nummer%,zwert%
  52. '
  53. ' *** refresh all data -> 1  
  54. '
  55. declare datenref%,timeref$
  56. '
  57. ' *** initialize variables
  58. let verkz%    = 1
  59. let cdakt%    = 1
  60. let cdplay$   = "01:00:00:00"
  61. let datenref% = 1
  62. let trenn$    = ":"
  63. let modus%    = 0
  64. color 1,15
  65.  
  66. ' *---------------------------*
  67. ' * MCI Error occured         *
  68. ' *---------------------------*
  69. proc mfehler
  70.   @messagebox("Media error occured!",\
  71.               "Ignore?",33)
  72.   case @equ(%button,2):let verkz%   = 0
  73. endproc
  74.  
  75. ' *---------------------------*
  76. ' * Determines CD data        *
  77. ' *---------------------------*
  78. proc cddaten
  79.    let cdanzs$  = @mcisend$("status cd number of tracks")
  80.    let cdlaen$  = @mcisend$("status cd length")
  81.    let cdanz%   = @val(cdanzs$)
  82.    let sub%     = 1 
  83.    let ende%    = 1
  84.    while ende%
  85.      list$ sub% = @mcisend$(@add$("status cd length track ",@str$(sub%)))
  86.      if @equ(sub%,cdanz%)
  87.         let ende% = 0
  88.      endif
  89.      inc sub%
  90.    wend
  91. endproc
  92. ' *---------------------------*
  93. ' * Fills box with data       *
  94. ' *---------------------------*
  95. proc aufbau
  96.   declare sub$
  97.   clearlist
  98.   let sub%  = 1
  99.   let ende% = 1
  100.   while ende%
  101.     let sub$=@str$(sub%)
  102.     case @lt(sub%,10):let sub$=@add$("0",sub$)
  103.     let zw$ = @add$(sub$," - ")
  104.     addstring @add$(zw$,@list$(sub%))
  105.     if @equ(sub%,cdanz%)
  106.       let ende% = 0
  107.     endif
  108.     inc sub%
  109.   wend
  110. endproc
  111.  
  112. ' *---------------------------*
  113. ' * displayes CD data and     *
  114. ' * und enables selection     *
  115. ' *---------------------------*
  116. proc cdlist
  117.   declare wahl$
  118.   let wahl$=@ListBox$("Track - length",0)
  119.   If @neq$(wahl$,"")
  120.     let nummer% = @add(%getcursel,1)
  121.     @mcisend$(@add$("play cd from ",@Str$(nummer%)))
  122.     ifnot @equ(%mcierror,0)
  123.       mfehler
  124.     endif
  125.   endif
  126. endproc
  127.  
  128. ' *---------------------------*
  129. ' * Create screen             *
  130. ' *---------------------------*
  131. proc schirm
  132.   cls
  133.   usebrush 1,0
  134.   rectangle 0,0-420,42
  135.   font 2
  136.   color 14,0
  137.   locate 1,2
  138.   print "Current position:"
  139.   locate 1,30
  140.   print "Time.....:"
  141.   locate 2,2
  142.   print "Total....:"
  143.   locate 2,30 
  144.   print "Total length:"
  145.   locate 3,2
  146.   print "Current track..:"
  147.   locate 3,30
  148.   print "Track length.:"
  149.   loadsizedbmp "WINLOGO.BMP",0,42-420,258;0
  150.   color 15,8
  151.   tbox 5,2 - 7,8;0
  152.   print "List"
  153.   tbox 9,2 -11,8;0
  154.   print "End"
  155.  
  156.   color 14,2
  157.   tbox  5,11- 7,15;0
  158.   print " 1 "
  159.   tbox  5,17- 7,21;0
  160.   print " 2 "
  161.   tbox  5,23- 7,27;0
  162.   print " 3 "
  163.   tbox  9,11-11,15;0
  164.   print " 4 "
  165.   tbox  9,17-11,21;0
  166.   print " 5 "
  167.   tbox  9,23-11,27;0
  168.   print " 6 "
  169.   tbox 13,11-15,15;0
  170.   print " 7 "
  171.   tbox 13,17-15,21;0
  172.   print " 8 "
  173.   tbox 13,23-15,27;0
  174.   print " 9 "
  175.   tbox 17,11-19,15;0
  176.   print " 1*"
  177.   tbox 17,17-19,21;0
  178.   print " 0 "
  179.   tbox 17,23-19,27;0
  180.   print " 2*"
  181.  
  182.   color 0,13
  183.   tbox  5,30- 7,35;0
  184.   print " << "
  185.   tbox  5,37- 7,42;0
  186.   print " -> "
  187.   tbox  5,44- 7,49;0
  188.   print " >> "
  189.   tbox  9,30-11,35;0
  190.   print " |< "
  191.   tbox  9,37-11,42;0
  192.   print " ## "
  193.   tbox  9,44-11,49;0
  194.   print " >| "
  195.   tbox 13,30-15,35;0
  196.   print " || "
  197.   tbox 13,37-15,49;0
  198.   print "  Shuffle "
  199.   tbox 17,37-19,49;0
  200.   print "  Normal  "
  201.  
  202.   color 14,0
  203. endproc
  204.  
  205. ' *---------------------------*
  206. ' * CD-Rom not found          *
  207. ' *---------------------------*
  208. proc mfehler2
  209.   @messagebox("CD-Rom not found or already used",\
  210.               "Program stop!",16)
  211.   let verkz% = 0 
  212. endproc
  213. ' *---------------------------*
  214. ' * incorrect selection       *
  215. ' *---------------------------*
  216. proc fehlaus
  217.   @messagebox("Track doesn't exist",\
  218.               "Note",0) 
  219. endproc
  220. ' *---------------------------*
  221. ' * Exit program              *
  222. ' *---------------------------*
  223. proc ende
  224.   @messagebox("Do you really want to exit?",\
  225.              "Qustion:",36)
  226.   case @equ(%button,6):let verkz% = 0 
  227. endproc
  228.  
  229. ' *---------------------------*
  230. ' * Create MCI command        *
  231. ' *---------------------------*
  232. proc mcivor
  233.    let mci1$   = @str$(cdmin%)
  234.    let mci1$   = @add$(mci1$,trenn$)
  235.    let mci1$   = @add$(mci1$,@str$(cdsec%))
  236.    let cdplay$ = @add$(@str$(cdakt%),trenn$)
  237.    let cdplay$ = @add$(cdplay$,mci1$)  
  238. endproc
  239.  
  240. ' *---------------------------*
  241. ' * select next track         *
  242. ' * has to be expanded        *
  243. ' *                           *
  244. ' *---------------------------*
  245. proc bestimme
  246. '  let zufall% = @rnd (cdanz%)
  247. '  inc zufall%
  248. '  let cdakt%  = zufall%
  249. endproc
  250.  
  251. ' *---------------------------*
  252. ' *  CD running mode          *
  253. ' *---------------------------*
  254. proc cdmodus
  255.   if @equ(modus%,1)
  256.      color 13,5
  257.      tbox 13,37-15,49;1
  258.      print "  Shuffle "
  259.      color 0,13
  260.      tbox 17,37-19,49;0
  261.      print "  Normal  "
  262.   else 
  263.      color 0,13
  264.      tbox 13,37-15,49;0
  265.      print "  Shuffle "
  266.      color 13,5
  267.      tbox 17,37-19,49;1
  268.      print "  Normal  "
  269.   endif
  270. endproc
  271.  
  272. ' *---------------------------*
  273. ' * Mode normal               *
  274. ' *---------------------------*
  275. proc cdnormal
  276.   let modus% = 0
  277.   cdmodus 
  278. endproc
  279.  
  280. ' *---------------------------*
  281. ' * Activate shuffle          *
  282. ' *---------------------------*
  283. proc cdshuffle
  284.   let modus% = 1
  285.   cdmodus
  286. endproc
  287.  
  288. ' *---------------------------*
  289. ' * Rebuild all data          *
  290. ' *---------------------------*
  291. proc datenerw
  292.    color 14,0
  293.    locate 2,21 
  294.    print cdanzs$
  295.    locate 2,44
  296.    print cdlaen$
  297.    locate 3,21
  298.    print @mid$(disp$,1,2)
  299.    locate 3,44
  300.    print @list$(cdakt%)
  301.    let datenref% = 0
  302.    let cdalt%    = cdakt%
  303. endproc
  304.  
  305. ' *---------------------------*
  306. ' * Data display              *
  307. ' *---------------------------*
  308.  
  309. proc datendisp
  310.     color 14,0
  311.     locate 1,44
  312.     print @time$(0)
  313.     let disp$  = @mcisend$("Status cd position")
  314.     ifnot @equ(%mcierror,0)
  315.       mfehler
  316.     else
  317.       locate 1,21
  318.       print @mid$(disp$,4,5)
  319.       if @equ(datenref%,1)
  320.         datenerw
  321.       endif 
  322.       let cdakt% = @val(@mid$(disp$,1,2))
  323.       ifnot @equ(cdakt%,cdalt%)
  324.         if @equ(modus%,1)
  325.            bestimme
  326.         endif
  327.         datenerw
  328.       endif
  329.     endif
  330. endproc
  331.  
  332. ' *---------------------------*
  333. ' * Play CD                   *
  334. ' *---------------------------*
  335. proc cdplay
  336.   @mcisend$(@add$("play cd from ",cdplay$))
  337.   ifnot @equ(%mcierror,0)
  338.     mfehler
  339.   endif
  340. endif
  341. endproc
  342.  
  343. ' *---------------------------*
  344. ' * one track back            *
  345. ' *---------------------------*
  346. proc cdback
  347.    let zahl% = cdakt% 
  348.    dec zahl%
  349.    if @gt(zahl%,0)
  350.       let cdakt%  = zahl%
  351.       let cdalt%  = cdakt%
  352.       let cdplay$ = @str$(cdakt%)
  353.       cdplay
  354.       let datenref% = 1 
  355.    endif 
  356. endproc
  357.  
  358. ' *---------------------------*
  359. ' * one track forward         *
  360. ' *---------------------------*
  361. proc cdfor
  362.    let zahl% = cdakt%
  363.    inc zahl%
  364.    ifnot @gt(zahl%,cdanz%)
  365.       let cdakt%  = zahl%
  366.       let cdalt%  = cdakt%
  367.       let cdplay$ = @str$(cdakt%)
  368.       cdplay 
  369.       let datenref% = 1     
  370.    endif
  371. endproc
  372.  
  373. ' *---------------------------*
  374. ' * CD back jumping                   *
  375. ' *---------------------------*
  376. proc cdstepb
  377.    let steppos$ = @mcisend$("status cd position")
  378.    let cdsec%   = @val(@mid$(steppos$,7,2))
  379.    let cdmin%   = @val(@mid$(steppos$,4,2))
  380.    let cdsec%   = @sub(cdsec%,15)
  381.    if @lt(cdsec%,0)
  382.       @add(cdsec%,60)
  383.       let cdmin% = @sub(cdmin%,1)
  384.       ifnot @lt(cdmin%,0)
  385.         mcivor
  386.         cdplay
  387.       endif
  388.    else
  389.       mcivor
  390.       cdplay
  391.    endif
  392. endproc
  393.  
  394. ' *---------------------------*
  395. ' * Stop CD                   *
  396. ' *---------------------------*
  397. proc cdstop
  398.    @MCISEND$("stop cd")
  399.    ifnot @equ(%mcierror,0)
  400.      mfehler
  401.    else
  402.      let cdakt%    = 1
  403.      let cdalt%    = 1
  404.      let datenref% = 1
  405.    endif
  406. endproc
  407.  
  408. ' *---------------------------*
  409. ' * CD forward jumping        *
  410. ' *---------------------------*
  411. proc cdstepf
  412.    let cdzw$    = @mid$(@mcisend$(@add$("status cd length track ",@str$(cdakt%))),1,5)
  413.    let cdmalt%  = @val(@mid$(cdzw$,1,2)
  414.    let cdsalt%  = @val(@mid$(cdzw$,4,2)
  415.    let steppos$ = @mcisend$("status cd position")
  416.    let cdsec%   = @val(@mid$(steppos$,7,2))
  417.    let cdmin%   = @val(@mid$(steppos$,4,2))
  418.    let cdsec%   = @add(cdsec%,15)
  419.    if @gt(cdsec%,60)
  420.       sub cdsec%,60
  421.       let cdmin% = @add(cdmin%,1)
  422.       ifnot @gt(cdmin%,cdmalt%)
  423.          ifnot @gt(cdsec%,cdsalt%)
  424.             mcivor
  425.             cdplay
  426.          endif
  427.       endif
  428.    else
  429.       mcivor
  430.       cdplay
  431.    endif
  432. endproc
  433.  
  434. ' *---------------------------*
  435. ' * Stop CD at current position*
  436. ' *---------------------------*
  437. proc cdhold
  438.    @MCISEND$("stop cd")
  439.      ifnot @equ(%mcierror,0)
  440.      mfehler
  441.    else
  442.      let cdplay$ = @mcisend$("status cd position") 
  443.    endif
  444. endproc
  445.  
  446. ' *---------------------------*
  447. ' * 10+                       *
  448. ' *---------------------------*
  449. proc asub1
  450.   if @tmouse(17,11-19,15)
  451.      locate 9,21
  452.      color 14,2 
  453.      tbox 17,11-19,15;0
  454.      print " 1*"
  455.      tbox 17,17-19,21;0
  456.      print " 0 "
  457.      tbox 17,23-19,27;0
  458.      print " 2*"
  459.      color 2,10
  460.      tbox 17,11-19,15;1
  461.      print " 1*"
  462.      color 14,0
  463.      let nummer% = 10
  464.   endif
  465.   if @tmouse(17,23-19,27)
  466.      locate 9,21
  467.      color 14,2 
  468.      tbox 17,11-19,15;0
  469.      print " 1*"
  470.      tbox 17,17-19,21;0
  471.      print " 0 "
  472.      tbox 17,23-19,27;0
  473.      print " 2*"
  474.      color 2,10
  475.      tbox 17,23-19,27;1
  476.      print " 2*"
  477.      color 14,0
  478.      let nummer% = 20
  479.   endif
  480. endproc
  481.  
  482. ' *---------------------------*
  483. ' * Play track per display *
  484. ' *---------------------------*
  485. proc asub2
  486.   ifnot @gt(nummer%,cdanz%)
  487.     let cdakt%    = nummer%
  488.     let cdalt%    = cdakt%
  489.     let cdplay$   = @str$(cdakt%)
  490.     cdplay 
  491.     let datenref% = 1
  492.   else
  493.     fehlaus
  494.   endif
  495.   color 14,2 
  496.   tbox 17,11-19,15;0
  497.   print " 1*"
  498.   tbox 17,17-19,21;0
  499.   print " 0 "
  500.   tbox 17,23-19,27;0
  501.   print " 2*"
  502.   let nummer% = 0
  503. endproc
  504.  
  505. ' *---------------------------*
  506. ' * Selection by Display      *
  507. ' *---------------------------*
  508. proc auswahl
  509.    let zwert% = 999
  510.    case @tmouse( 5,11- 7,15):let zwert% = 1
  511.    case @tmouse( 5,17- 7,21):let zwert% = 2
  512.    case @tmouse( 5,23- 7,27):let zwert% = 3 
  513.    case @tmouse( 9,11-11,15):let zwert% = 4
  514.    case @tmouse( 9,17-11,21):let zwert% = 5
  515.    case @tmouse( 9,23-11,27):let zwert% = 6 
  516.    case @tmouse(13,11-15,15):let zwert% = 7
  517.    case @tmouse(13,17-15,21):let zwert% = 8
  518.    case @tmouse(13,23-15,27):let zwert% = 9 
  519.    case @tmouse(17,11-19,15):asub1
  520.    case @tmouse(17,17-19,21):let zwert% = 0
  521.    case @tmouse(17,23-19,27):asub1
  522.    if @neq(zwert%,999)
  523.       let nummer% = @add(nummer%,zwert%)
  524.       if @neq(nummer%,0)
  525.          asub2
  526.       endif
  527.    endif
  528. endproc
  529.  
  530. ' *---------------------------*
  531. ' * Mainprogram               *
  532. ' *---------------------------*
  533. WindowTitle "PROFAN▓ CD-Player 1.5"
  534. windowstyle 10
  535. window 50,50-420,300
  536.  
  537. Cls
  538.  
  539. locate 9,8
  540. print "Initialize CD-Player ..."
  541. @mcisend$("open cdaudio alias cd")
  542. ifnot @equ(%mcierror,0)
  543.   mfehler2
  544.   case @equ(verkz%,0):end
  545. endif
  546. @mcisend$("set cd time format tmsf")
  547.  
  548. cddaten
  549. aufbau
  550. schirm
  551. cdmodus
  552. datendisp
  553.  
  554. while verkz%
  555.    if @equ(%mousekey,1)
  556.       if @tmouse( 5, 2- 7, 8)
  557.         cdlist
  558.       endif
  559.       case @tmouse( 9, 2-11, 8):ende
  560.       case @tmouse( 5,11-19,27):auswahl
  561.       case @tmouse( 5,30- 7,35):cdback
  562.       case @tmouse( 5,37- 7,42):cdplay
  563.       case @tmouse( 5,44- 7,49):cdfor
  564.       case @tmouse( 9,30-11,35):cdstepb
  565.       case @tmouse( 9,37-11,42):cdstop
  566.       case @tmouse( 9,44-11,49):cdstepf
  567.       case @tmouse(13,30-15,35):cdhold
  568.       case @tmouse(13,43-15,49):cdshuffle
  569.       case @tmouse(17,43-19,49):cdnormal
  570.    else
  571.       datendisp
  572.    endif
  573. wend
  574. end
  575.